Исходный текст

Option Explicit
Call ExportUsersInfo()


'==============================================================================
' Вывести в MSExcel информацию обо всех пользователях, созданных в настройке
'==============================================================================
Sub ExportUsersInfo()

        On Error Resume Next
        Err = 0    
        
        Dim ExcelApp, WrkBook, AllUsers, user, List, str, i

        'Если нет информации о пользователях, выйти из процедуры
        If ThisApplication.Users.Count = 0 Then 
                MsgBox "Пользователи в системе отсутствуют.", _
                        vbInformation, "Информация о текущей настройке"
                Exit Sub
        End If

        'Открыть приложение Excel
        Set ExcelApp = CreateObject("Excel.Application")
        If Err <> 0 Then 'Ошибка открытия ...
                MsgBox "Невозможно открыть приложение MS Excel.",  vbInformation, "ошибка MS Excel" 
                Exit Sub
        End If
                            
        ' Добавить рабочую книгу
        Set WrkBook = ExcelApp.Workbooks.Add
        Set List = WrkBook.ActiveSheet
    
        'Вывести на текущий лист информацию о пользователях
        i = 2
        Set AllUsers = ThisApplication.Users ' Получить коллекцию пользователей
        For Each user In AllUsers
                List.Cells(i, 1) = user.Description 'Краткое описание
                List.Cells(i, 2) = user.LastName & " " & user.FirstName & " " & user.MiddleName 'ФИО
                List.Cells(i, 3) = user.Position 'Должность
                List.Cells(i, 4) = user.Department 'Отдел
                List.Cells(i, 5) = user.Phone 'Телефон
                If user.AllowLogin Then str = "Да" 'Пользователь TDMS?
                List.Cells(i, 6) = str
                i = i + 1
                str = ""
        Next
        
        'Отформатировать шапку таблицы
        List.Cells(1,1) = "Краткое описание"            
        List.Cells(1,2) =     "ФИО"
        List.Cells(1,3) = "Должность"            
        List.Cells(1,4) =     "Отдел"
        List.Cells(1,5) = "Телефон"            
        List.Cells(1,6) =     "Пользователь TDMS?"
        List.Rows(1).Font.Size = 12
        List.Rows(1).Font.Bold = TRUE
        List.Columns.AutoFit
        
        'Показать окно Excel
        ExcelApp.Application.Visible = TRUE
End Sub 
'==============================================================================